home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE09 / FILES / NAMES3U.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-09  |  9KB  |  315 lines
  1. unit Names3u;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Menus, Buttons, ExtCtrls, StdCtrls, ClipBrd, Mask, Names3U2;
  8.  
  9. const
  10.   wm_MadeUpMsg = wm_User + 100;
  11.   RecordNumStr = '%d of %d';
  12.  
  13. type
  14.   TState = (sInactive, sBrowse, sChange, sAppend);
  15.  
  16.   TDataForm = class(TForm)
  17.     MainMenu1: TMainMenu;
  18.     FirstMnu: TMenuItem;
  19.     PriorMnu: TMenuItem;
  20.     NextMnu: TMenuItem;
  21.     LastMnu: TMenuItem;
  22.     FileMnu: TMenuItem;
  23.     EditMnu: TMenuItem;
  24.     DeleteMnu: TMenuItem;
  25.     PasteMnu: TMenuItem;
  26.     CopyMnu: TMenuItem;
  27.     CutMnu: TMenuItem;
  28.     UndoMnu: TMenuItem;
  29.     ExitBtn: TMenuItem;
  30.     IgnoreMe2: TMenuItem;
  31.     IgnoreMe1: TMenuItem;
  32.     SpeedBar: TPanel;
  33.     UndoBtn: TSpeedButton;
  34.     CutBtn: TSpeedButton;
  35.     CopyBtn: TSpeedButton;
  36.     PasteBtn: TSpeedButton;
  37.     FirstBtn: TSpeedButton;
  38.     PriorBtn: TSpeedButton;
  39.     NextBtn: TSpeedButton;
  40.     LastBtn: TSpeedButton;
  41.     SpeedButton1: TSpeedButton;
  42.     NameEdt: TEdit;
  43.     StatusLine: TPanel;
  44.     RecordNum: TPanel;
  45.     DOBEdt: TMaskEdit;
  46.     IgnoreMe3: TMenuItem;
  47.     NewMnu: TMenuItem;
  48.     IgnoreMe4: TMenuItem;
  49.     ChangeMnu: TMenuItem;
  50.     NewBtn: TSpeedButton;
  51.     ChangeBtn: TSpeedButton;
  52.     DeleteBtn: TSpeedButton;
  53.     procedure FormCreate(Sender: TObject);
  54.     procedure FormDestroy(Sender: TObject);
  55.     procedure NewClick(Sender: TObject);
  56.     procedure ChangeClick(Sender: TObject);
  57.     procedure FirstClick(Sender: TObject);
  58.     procedure PriorClick(Sender: TObject);
  59.     procedure NextClick(Sender: TObject);
  60.     procedure LastClick(Sender: TObject);
  61.     procedure ExitClick(Sender: TObject);
  62.     procedure EditItemClick(Sender: TObject);
  63.     procedure EditBoxKeyUp(Sender: TObject; var Key: Word;
  64.       Shift: TShiftState);
  65.     procedure EditBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
  66.       Y: Integer);
  67.     procedure EditBoxMouseDown(Sender: TObject; Button: TMouseButton;
  68.       Shift: TShiftState; X, Y: Integer);
  69.     procedure EditBoxChange(Sender: TObject);
  70.     procedure EditBoxExit(Sender: TObject);
  71.   private
  72.     { Defaults to sInactive }
  73.     FState: TState;
  74.     procedure DoHint(Sender: TObject);
  75.     procedure SetupButtons;
  76.     procedure SetUpClipBoardItems(Sender: TComponent);
  77.     procedure ShowRecord(RecNo: Cardinal);
  78.     procedure ShowRecNo(RecNo: Cardinal);
  79.     procedure WMMadeUpMsg(var Msg: TMessage); message wm_MadeUpMsg;
  80.     procedure SetState(State: TState);
  81.   public
  82.     DataFile: TDataFile;
  83.     DataRec: TDataRec;
  84.     property State: TState read FState write SetState;
  85.   end;
  86.  
  87. var
  88.   DataForm: TDataForm;
  89.  
  90. implementation
  91.  
  92. {$R *.DFM}
  93.  
  94. procedure TDataForm.DoHint(Sender: TObject);
  95. begin
  96.   StatusLine.Caption := Application.Hint;
  97. end;
  98.  
  99. procedure TDataForm.SetState(State: TState);
  100. begin
  101.   if FState <> State then
  102.   begin
  103.     if FState in [sChange, sAppend] then
  104.     begin
  105.       DataRec.Name := NameEdt.Text;
  106.       DataRec.DOB := StrToDate(DOBEdt.Text);
  107.       DataFile.Records[DataFile.Current] := DataRec;
  108.     end;
  109.     FState := State;
  110.     if FState = sAppend then
  111.       DataFile.Current := DataFile.Count;
  112.     ShowRecNo(DataFile.Current);
  113.     SetupButtons;
  114.     ChangeMnu.Enabled := FState <> sInactive;
  115.     ChangeBtn.Enabled := ChangeMnu.Enabled;
  116.     ChangeMnu.Checked := State in [sChange, sAppend];
  117.     ChangeBtn.Down := ChangeMnu.Checked;
  118.     NameEdt.Enabled := ChangeMnu.Checked;
  119.     DOBEdt.Enabled := ChangeMnu.Checked;
  120.   end;
  121. end;
  122.  
  123. procedure TDataForm.SetupButtons;
  124. begin
  125.   FirstBtn.Enabled := DataFile.Current > 0;
  126.   FirstMnu.Enabled := FirstBtn.Enabled;
  127.   PriorBtn.Enabled := FirstBtn.Enabled;
  128.   PriorMnu.Enabled := FirstBtn.Enabled;
  129.   NextBtn.Enabled := DataFile.Current < Pred(DataFile.Count);
  130.   NextMnu.Enabled := NextBtn.Enabled;
  131.   LastBtn.Enabled := NextBtn.Enabled;
  132.   LastMnu.Enabled := NextBtn.Enabled;
  133. end;
  134.  
  135. procedure TDataForm.SetUpClipBoardItems(Sender: TComponent);
  136. var
  137.   EditCtl: TCustomEdit;
  138. begin
  139.   if (Sender is TCustomEdit) and TCustomEdit(Sender).Enabled then
  140.   begin
  141.     EditCtl := Sender as TCustomEdit;
  142.     UndoMnu.Enabled := Bool(EditCtl.Perform(em_CanUndo, 0, 0));
  143.     UndoBtn.Enabled := UndoMnu.Enabled;
  144.     CutMnu.Enabled := EditCtl.SelLength > 0;
  145.     CutBtn.Enabled := CutMnu.Enabled;
  146.     CopyMnu.Enabled := CutMnu.Enabled;
  147.     CopyBtn.Enabled := CutMnu.Enabled;
  148.     PasteMnu.Enabled := ClipBoard.AsText <> '';
  149.     PasteBtn.Enabled := PasteMnu.Enabled;
  150.     DeleteMnu.Enabled := EditCtl.SelLength > 0;
  151.     DeleteBtn.Enabled := DeleteMnu.Enabled;
  152.   end
  153.   else
  154.   begin
  155.     UndoMnu.Enabled := False;
  156.     UndoBtn.Enabled := False;
  157.     CutMnu.Enabled := False;
  158.     CutBtn.Enabled := False;
  159.     CopyMnu.Enabled := False;
  160.     CopyBtn.Enabled := False;
  161.     PasteMnu.Enabled := False;
  162.     PasteBtn.Enabled := False;
  163.     DeleteMnu.Enabled := False;
  164.     DeleteBtn.Enabled := False;
  165.   end;
  166. end;
  167.  
  168. procedure TDataForm.ShowRecord(RecNo: Cardinal);
  169. begin
  170.   try
  171.     ShowRecNo(RecNo);
  172.     with DataFile[RecNo] do
  173.     begin
  174.       NameEdt.Text := Name;
  175.       DOBEdt.Text := DateToStr(DOB);
  176.     end;
  177.     State := sBrowse;
  178.     SetupButtons;
  179.   except
  180.     on EListError do { Nothing }
  181.   end;
  182. end;
  183.  
  184. { Pass in real record number, and it adds 1 (they start at 0) }
  185. procedure TDataForm.ShowRecNo(RecNo: Cardinal);
  186. begin
  187.   if State = sAppend then
  188.     RecordNum.Caption := Format(RecordNumStr, [Succ(RecNo), Succ(DataFile.Count)])
  189.   else
  190.     if DataFile.Count > 0 then
  191.       RecordNum.Caption := Format(RecordNumStr, [Succ(RecNo), DataFile.Count])
  192.     else
  193.       RecordNum.Caption := 'No records';
  194. end;
  195.  
  196. procedure TDataForm.WMMadeUpMsg(var Msg: TMessage);
  197. begin
  198.   SetUpClipBoardItems(ActiveControl);
  199. end;
  200.  
  201. procedure TDataForm.FormCreate(Sender: TObject);
  202. begin
  203.   Application.OnHint := DoHint;
  204.   { When the form has finished setting itself up, (i.e. all }
  205.   { the controls have been made and focus has been given to }
  206.   { one of them) this posted message will be processed and }
  207.   { so the edit buttons/menus will be in a sensible state }
  208.   PostMessage(Handle, wm_MadeUpMsg, 0, 0);
  209.   DataFile := TDataFile.Create;
  210.   NewMnu.Enabled := True;
  211.   ShowRecord(0);
  212. end;
  213.  
  214. procedure TDataForm.FormDestroy(Sender: TObject);
  215. begin
  216.   if Assigned(DataFile) then
  217.     DataFile.Free;
  218. end;
  219.  
  220. procedure TDataForm.NewClick(Sender: TObject);
  221. begin
  222.   State := sAppend;
  223.   NameEdt.SetFocus;
  224. end;
  225.  
  226. procedure TDataForm.ChangeClick(Sender: TObject);
  227. const
  228.   States: array[Boolean] of TState = (sBrowse, sChange);
  229.   Hints: array[Boolean] of String[14] = ('Change record|', 'Save changes|');
  230. begin
  231.   State := States[State = sBrowse];
  232.   ChangeBtn.Hint := Hints[ChangeBtn.Down]
  233. end;
  234.  
  235. procedure TDataForm.FirstClick(Sender: TObject);
  236. begin
  237.   State := sBrowse;
  238.   DataFile.Current := 0;
  239.   ShowRecord(DataFile.Current);
  240. end;
  241.  
  242. procedure TDataForm.PriorClick(Sender: TObject);
  243. begin
  244.   State := sBrowse;
  245.   DataFile.Current := DataFile.Current - 1;
  246.   ShowRecord(DataFile.Current);
  247. end;
  248.  
  249. procedure TDataForm.NextClick(Sender: TObject);
  250. begin
  251.   State := sBrowse;
  252.   DataFile.Current := Succ(DataFile.Current);
  253.   ShowRecord(DataFile.Current);
  254. end;
  255.  
  256. procedure TDataForm.LastClick(Sender: TObject);
  257. begin
  258.   State := sBrowse;
  259.   DataFile.Current := Pred(DataFile.Count);
  260.   ShowRecord(DataFile.Current);
  261. end;
  262.  
  263. procedure TDataForm.ExitClick(Sender: TObject);
  264. begin
  265.   Close;
  266. end;
  267.  
  268. procedure TDataForm.EditItemClick(Sender: TObject);
  269. begin
  270.   if ActiveControl is TCustomEdit then
  271.     with TCustomEdit(ActiveControl) do
  272.       case (Sender as TComponent).Tag of
  273.         1: Perform(em_Undo, 0, 0);
  274.         2: CutToClipBoard;
  275.         3: CopyToClipBoard;
  276.         4: PasteFromClipBoard;
  277.         5: ClearSelection;
  278.       end;
  279. end;
  280.  
  281. procedure TDataForm.EditBoxKeyUp(Sender: TObject; var Key: Word;
  282.   Shift: TShiftState);
  283. begin
  284.   SetUpClipBoardItems(Sender as TComponent);
  285. end;
  286.  
  287. procedure TDataForm.EditBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
  288.   Y: Integer);
  289. begin
  290.   if ssLeft in Shift then
  291.     SetUpClipBoardItems(Sender as TComponent);
  292. end;
  293.  
  294. procedure TDataForm.EditBoxMouseDown(Sender: TObject; Button: TMouseButton;
  295.   Shift: TShiftState; X, Y: Integer);
  296. begin
  297.   SetUpClipBoardItems(Sender as TComponent);
  298. end;
  299.  
  300. procedure TDataForm.EditBoxChange(Sender: TObject);
  301. begin
  302.   SetUpClipBoardItems(Sender as TComponent);
  303. end;
  304.  
  305. procedure TDataForm.EditBoxExit(Sender: TObject);
  306. begin
  307.   SetUpClipBoardItems(ActiveControl);
  308. end;
  309.  
  310. initialization
  311.   { Since all labels on the form have had their names removed }
  312.   { this line prevents a startup error - remove it and see }
  313.   RegisterClasses([TLabel]);
  314. end.
  315.